home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue37 / outlook / Example1 / ComHelloWorld1.pas next >
Encoding:
Pascal/Delphi Source File  |  1998-04-30  |  4.3 KB  |  214 lines
  1. {
  2.  
  3. Most simple example of adding a menu item to Exchange
  4. or Outlook.
  5.  
  6. }
  7.  
  8.  
  9.  
  10. unit ComHelloWorld1;
  11.  
  12. interface
  13.  
  14. uses
  15.   Windows,
  16.   CommCtrl,
  17.   ExchExt;
  18.  
  19.  
  20. type
  21.   TExchExt = class(TInterfacedObject, IExchExt, IExchExtCommands)
  22.   protected
  23.   { IExchExt }
  24.     function Install(
  25.                eecb: IEXCHEXTCALLBACK;
  26.                mecontext: ULONG;
  27.                ulFlags: ULONG): HResult; stdcall;
  28.   { IExchExtCommands }
  29.     function InstallCommands(
  30.                eecb: IEXCHEXTCALLBACK;
  31.                hwnd: HWND;
  32.                hmenu: HMENU;
  33.                var cmdidBase: UINT;
  34.                lptbeArray: LPTBENTRY;
  35.                ctbe: UINT;
  36.                ulFlags: ULONG): HResult; stdcall;
  37.     procedure InitMenu(
  38.                 eecb: IExchExtCallback); stdcall;
  39.     function DoCommand(
  40.               eecb: IEXCHEXTCALLBACK;
  41.               cmdid: UINT): HResult; stdcall;
  42.     function Help(
  43.                eecb: IEXCHEXTCALLBACK;
  44.                cmdid: UINT): HResult; stdcall;
  45.     function QueryHelpText(
  46.                cmdid: UINT;
  47.                ulFlags: ULONG;
  48.                lpsz: LPTSTR;
  49.                cch: UINT): HResult; stdcall;
  50.     function QueryButtonInfo(
  51.                tbid: ULONG;
  52.                itbb: UINT;
  53.                ptbb: PTBBUTTON;
  54.                lpsz: LPTSTR;
  55.                cch: UINT;
  56.                ulFlags: ULONG): HResult; stdcall;
  57.     function ResetToolbar(
  58.                tbid: ULONG;
  59.                ulFlags: ULONG): HResult; stdcall;
  60.   private
  61.     MyCommandNum: integer;
  62.   end;
  63.  
  64.  
  65.  
  66. implementation
  67.  
  68. uses
  69.   Dialogs;
  70.  
  71.  
  72. { IExchExt }
  73.  
  74. function TExchExt.Install(
  75.   eecb: IEXCHEXTCALLBACK;
  76.   mecontext: ULONG;
  77.   ulFlags: ULONG): HResult;
  78. var
  79.   ulBuildVersion: ULONG;
  80. begin
  81. { make sure this is the right version... }
  82.   eecb.GetVersion(ulBuildVersion, EECBGV_GETBUILDVERSION);
  83.   if (EECBGV_BUILDVERSION_MAJOR <> (ulBuildVersion and EECBGV_BUILDVERSION_MAJOR_MASK)) then  begin
  84.     Result := S_FALSE;
  85.     Exit;
  86.   end;
  87.  
  88. { in which context(s) do we want to show up? }
  89.   case mecontext of
  90.     EECONTEXT_VIEWER: Result := S_OK;
  91.   else
  92.     Result := S_FALSE;
  93.   end; { of case }
  94.  
  95. end;
  96.  
  97.  
  98.  
  99. { IExchExtCommands }
  100.  
  101. function TExchExt.InstallCommands(
  102.   eecb: IEXCHEXTCALLBACK;
  103.   hwnd: HWND;
  104.   hmenu: HMENU;
  105.   var cmdidBase: UINT;
  106.   lptbeArray: LPTBENTRY;
  107.   ctbe: UINT;
  108.   ulFlags: ULONG): HResult;
  109. var
  110.   r: HResult;
  111.   hMenuTools: Windows.HMENU;
  112. begin
  113.   r := eecb.GetMenuPos(EECMDID_ToolsOptions, hMenuTools, nil, nil, 0);
  114.   if r <> S_OK then  begin
  115.     Result := S_FALSE;
  116.     Exit;
  117.   end;
  118.  
  119.   // add a menu separator
  120.   AppendMenu(
  121.     hMenuTools,
  122.     MF_SEPARATOR,
  123.     0,
  124.     nil);
  125.  
  126.   // add our extension command
  127.   MyCommandNum := cmdidBase;
  128.   AppendMenu(
  129.     hMenuTools,
  130.     MF_BYPOSITION and MF_STRING,
  131.     MyCommandNum,
  132.     'Hello World 1');
  133.   Inc(cmdidBase);
  134.  
  135.   Result := S_OK;
  136. end;
  137.  
  138.  
  139. procedure TExchExt.InitMenu(
  140.             eecb: IExchExtCallback);
  141. begin
  142.   // do nothing
  143. end;
  144.  
  145.  
  146. function TExchExt.DoCommand(
  147.           eecb: IEXCHEXTCALLBACK;
  148.           cmdid: UINT): HResult;
  149. begin
  150.   if cmdid = MyCommandNum
  151.     then  begin
  152.       ShowMessage('Hello World 1!');
  153.       Result := S_OK;
  154.     end
  155.     else
  156.       Result := S_FALSE;
  157. end;
  158.  
  159.  
  160. function TExchExt.Help(
  161.            eecb: IEXCHEXTCALLBACK;
  162.            cmdid: UINT): HResult;
  163. begin
  164.   if (cmdid = MyCommandNum)
  165.     then  begin
  166.       ShowMessage('Sorry, my boss didn''t schedule time to implement a help file...');
  167.       Result := S_OK;
  168.     end
  169.     else
  170.       Result := S_FALSE;
  171. end;
  172.  
  173.  
  174. function TExchExt.QueryHelpText(
  175.            cmdid: UINT;
  176.            ulFlags: ULONG;
  177.            lpsz: LPTSTR;
  178.            cch: UINT): HResult;
  179. const
  180.   HelpMsgHelloWorld:PChar = 'Click to say hello';
  181. begin
  182.   if (cmdid = MyCommandNum) and ((ulFlags and EECQHT_STATUS) <> 0)
  183.     then  begin
  184.       lstrcpyn(lpsz, HelpMsgHelloWorld, cch);
  185.       Result := S_OK;
  186.     end
  187.     else
  188.       Result := S_FALSE;
  189. end;
  190.  
  191.  
  192. function TExchExt.QueryButtonInfo(
  193.            tbid: ULONG;
  194.            itbb: UINT;
  195.            ptbb: PTBBUTTON;
  196.            lpsz: LPTSTR;
  197.            cch: UINT;
  198.            ulFlags: ULONG): HResult;
  199. begin
  200.   Result := S_FALSE;
  201. end;
  202.  
  203.  
  204. function TExchExt.ResetToolbar(
  205.            tbid: ULONG;
  206.            ulFlags: ULONG): HResult;
  207. begin
  208.   Result := S_FALSE;
  209. end;
  210.  
  211.  
  212.  
  213. end.
  214.